home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
PET
/
S-Super PET
/
(s)tz.d64
/
SAVE.ASM
< prev
next >
Wrap
Assembly Source File
|
2009-01-18
|
6KB
|
209 lines
opt nolist ;IO routines: SAVE
xdef read_it,write_it,identification
xref address, buffer_2,buffer,offset,filename,names ;variables
xref line_number,nb_columns,dist_between_names ;variables
xref nb_lines,precision,io_error
xref calculate_address,get_a_char,answer_same_line ;routines
xref set_precision ;routine
xref openf_,fgetrec_,fputrec_,closef_,copystr_,copy_,length_
read_it ldd #read_command
jsr open_file
jsr check_for_error
if eq ;if no IO error
ldd #nb_lines ;input of parameters
std address
jsr read_from_disk
jsr set_precision
ldd #0
std offset
clr line_number ;IO = 0
loop
jsr calculate_address
jsr read_from_disk
jsr check_for_error
bne quit_reading ;if there was an error
inc line_number
ldb line_number
cmpb nb_lines
until eq
ldd #names ;input of line names
std address
clr line_number
loop
clra
ldb dist_between_names ;maximum length of record
pshs d
ldd address
pshs d
ldd control_block
jsr fgetrec_ ;length of input record left in B
leas 4,s
ldy address
clr b,y ;add null byte at end of string
jsr check_for_error
bne quit_reading
inc line_number
ldb line_number
cmpb nb_lines
beq quit_reading
ldd address
addb dist_between_names
adca #0
std address
endloop
quit_reading ldd control_block
jsr closef_
endif
rts
read_from_disk ldd #80
pshs d
ldd #buffer
pshs d
ldd control_block
jsr fgetrec_
leas 4,s
pshs d ;number of chars read
ldd address
pshs d ;where to copy
ldd #buffer
jsr copy_
leas 4,s
rts
write_it ldd #$b191 ;'w
jsr open_file
jsr check_for_error
if eq ;if no IO error
ldd #precision
subd #nb_lines ;length of parameter record
std length
ldd #nb_lines
jsr write_on_disk
ldb nb_columns ;length of records to be sent
lda #5 ;(5 bytes per column) x number of col.
mul
std length
ldd #0
std offset
clr line_number
loop
jsr calculate_address
jsr write_on_disk
jsr check_for_error
bne quit_writing ;if there was an IO error
inc line_number
ldb line_number
cmpb nb_lines
until eq
ldd #names
std address
clr line_number
loop ;line IDs written to file
ldd address
jsr length_
pshs d
ldd address
pshs d
ldd control_block
jsr fputrec_
leas 4,s
jsr check_for_error
bne quit_writing
inc line_number
ldb line_number
cmpb nb_lines
beq quit_writing
ldd address
addb dist_between_names
adca #0
std address
endloop
endif
quit_writing ldd control_block
jsr closef_
rts
write_on_disk ldx length
pshs x
pshs d ;address sent through D when called
ldd control_block
jsr fputrec_
leas 4,s
rts
;routine to OPEN_FILE whose name's address is in D
open_file pshs d ;open mode: 'r or 'w
ldd #filename
jsr openf_
std control_block
leas 2,s
rts
identification ldd #filename_prompt
ldx #filename
jsr answer_same_line
rts
;routine to CHECK_FOR_ERROR in IO operations
check_for_error ldb $6a ;address of IO status
if ne ;in case of IO error
ldd #buffer ;err. message put aside in case disk drive
pshs d ;has not detected it
ldd #$301
jsr copystr_
leas 2,s
ldd #read_command ;disk drive command channel
pshs d
ldd #name
jsr openf_
std address
leas 2,s
ldd #20 ;input of error message
pshs d
ldd #buffer_2
pshs d
ldd address
jsr fgetrec_
leas 4,s
addd #buffer_2 ;null byte at end of string
tfr d,y
clr ,y
ldd address
jsr closef_
ldb buffer_2
cmpb #'0 ;start of '00, OK,00,00' string
if eq ;if error does not come from drive
ldd #buffer ; then first message recalled
else
ldd #buffer_2 ;otherwise, drive's message displayed
endif
pshs d
clrb ;any char allowed as an answer
ldx #notice
jsr get_a_char
leas 2,s
ldb #1 ;to set error flag
endif
stb io_error ;error flag
rts
length rmb 2
read_command fcb "r",0
control_block rmb 2
filename_prompt fcc "File title ? "
fcb 0
notice fcc "There is an IO error: %s%n"
fcc "Please correct, then press any key "
fcb 0
name fcc "disk"
fcb 0
end